home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr52
/
clmsflpc.zip
/
BIN.PRG
< prev
Wrap
Text File
|
1993-06-24
|
4KB
|
166 lines
/*
===============================================================
Quick BASIC numeral conversion routines for CLIPPER
PUBLIC DOMAIN
cheerfully provided
by Staben Technologies
811 West 14th Avenue
Spokane, Washington 99204
===============================================================
*/
FUNCTION BIN2DEC(binval)
local pt1, pt2, value, y, x
/*
routine to convert a binary number to a decimal. Decimal points
will be used to separate the whole from the fractional part
n+1 n 0 -1 -2 -n -n-1
2^ + 2^ ... + 2^ + 2^ + 2^ ... 2^ + 2^
-------------------- -----------------------
Whole Part . Fractional Part
*/
/* find a decimal point, and split it */
if "."$binval
pt1 := subs(binval,1,at('.',binval)-1)
pt2 := subs(binval,at('.',binval)+1)
else
pt1 := binval
pt2 := ""
endif
value := 0
y := 0
/* whole portion */
for x := len(pt1) to 1 step -1
if subs(pt1,x,1) == "1"
value := value+2^y
endif
y := y+1
next
/* fractional portion */
if len(pt2) > 0
y := -1
for x := 1 to len(pt2)
if subs(pt2,x,1) == "1"
value := value+2^y
endif
y := y-1
next
endif
return(value)
FUNCTION DEC2BIN(value,length)
local done, hibit, x, subvalue, binval
/* first find highest bit */
if length == NIL
length := 64
endif
done := .f.
hibit := 0
do while .not. done
if 2^hibit > value
done := .t.
else
hibit := hibit+1
endif
enddo
/* create string */
binval := ""
subvalue := int(value)
/* first, the whole value */
for x := hibit to 0 step -1
if 2^x <= subvalue
binval := binval + "1"
subvalue := subvalue - 2^x
else
binval := binval + "0"
endif
next
/* second, the fractional portion */
subvalue := value - int(value)
if subvalue > 0
binval := binval + "."
/* do the decimal portion */
done := .f.
x := -1
do while .not. done
if subvalue >= 2^x
subvalue := subvalue - 2^x
binval := binval + "1"
else
binval := binval + "0"
endif
if subvalue <= 0 .or. subvalue == 0 .or. subvalue < 0.00001
done := .t.
endif
x := x-1
enddo
endif
/* and pad it up */
binval := repl('0',64)+binval
binval := subs(binval,(len(binval)-length)+1)
return(binval)
FUNCTION cvi(strng)
local first,last,total
/*
Simple function convert a two-byte string to numbers *integer*
(BASIC's CVI() function)
*/
first := asc(subs(strng,1,1))
last := asc(subs(strng,2,1))
total := first+(last*256)
return(total)
FUNCTION cv(strng)
/*
Simple function convert up to 64-bit precision a number stored as a string
in MICROSOFT FLOATING POINT FORMAT (cvs(), cvd(), etc.)
*/
local b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17,b18,b19,b20
local b21,b22,b23,b24,b25,b26,b27,b28,b29,b30,b31,b32,b33,b34,b35,b36,b37,b38
local b39,b40,b41,b42,b43,b44,b45,b46,b47,b48,b49,b50,b51,b52,b53,b54,b55,b56
local b57,b58,b59,b60,b61,b62,b63,b64
local nvar
local realbinary,mantissa,exponent,positive,realvalue
local x
if strng == repl(chr(0),len(strng))
return(0)
endif
for x := 1 to len(strng)
nvar := "b"+alltrim(str(x))
&nvar := dec2bin(asc(subs(strng,x,1)),8)
next
realbinary := ""
for x := len(strng) to 1 step -1
nvar := "b"+alltrim(str(x))
realbinary := realbinary+&nvar
next
exponent := asc(subs(strng,len(strng),1)) - 128
positive := if(subs(realbinary,9,1) == "0",.T.,.F.)
mantissa := "1"+subs(realbinary,10,23)
if exponent > 0
realvalue := bin2dec(subs(mantissa,1,exponent)+"."+subs(mantissa,exponent+1))
else
realvalue := bin2dec("."+repl("0",-1*exponent)+mantissa)
endif
if .not. positive
realvalue := realvalue * -1
endif
return(realvalue)